home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / entry.lisp < prev    next >
Encoding:
Text File  |  1991-11-06  |  4.5 KB  |  127 lines
  1. ;;; -*- Package: C; Log: C.Log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: entry.lisp,v 1.9 91/05/16 00:24:38 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;;    Code in this file handles VM-independent details of run-time
  15. ;;; function representation that primarily concern IR2 conversion and the
  16. ;;; dumper/loader. 
  17. ;;; 
  18. ;;; Written by Rob MacLachlan
  19. ;;;
  20. (in-package 'c)
  21.  
  22.  
  23. ;;; Entry-Analyze  --  Interface
  24. ;;;
  25. ;;;    This phase runs before IR2 conversion, initializing each XEP's
  26. ;;; Entry-Info structure.  We call the VM-supplied Select-Component-Format
  27. ;;; function to make VM-dependent initializations in the IR2-Component.  This
  28. ;;; includes setting the IR2-Component-Kind and allocating fixed implementation
  29. ;;; overhead in the constant pool.  If there was a forward reference to a
  30. ;;; function, then the ENTRY-INFO will already exist, but will be
  31. ;;; uninitialized.
  32. ;;;
  33. (defun entry-analyze (component)
  34.   (let ((2comp (component-info component)))
  35.     (dolist (fun (component-lambdas component))
  36.       (when (external-entry-point-p fun)
  37.     (let ((info (or (leaf-info fun)
  38.             (setf (leaf-info fun) (make-entry-info)))))
  39.       (compute-entry-info fun info)
  40.       (push info (ir2-component-entries 2comp))))))
  41.  
  42.   (select-component-format component)
  43.   (undefined-value))
  44.  
  45.  
  46. ;;; Make-Arg-Names  --  Internal
  47. ;;;
  48. ;;;    Takes the list representation of the debug arglist and turns it into a
  49. ;;; string.
  50. ;;;
  51. (defun make-arg-names (x)
  52.   (declare (type functional x))
  53.   (let ((args (functional-arg-documentation x)))
  54.     (assert (not (eq args :unspecified)))
  55.     (if (null args)
  56.     "()"
  57.     (let ((*print-pretty* t)
  58.           (*print-escape* t)
  59.           (*print-base* 10)
  60.           (*print-radix* nil)
  61.           (*print-case* :downcase))
  62.       (write-to-string args)))))
  63.   
  64.  
  65. ;;; Compute-Entry-Info  --  Internal
  66. ;;;
  67. ;;;    Initialize Info structure to correspond to the XEP lambda Fun.
  68. ;;;
  69. (defun compute-entry-info (fun info)
  70.   (declare (type clambda fun) (type entry-info info))
  71.   (let ((bind (lambda-bind fun))
  72.     (internal-fun (functional-entry-function fun)))
  73.     (setf (entry-info-closure-p info)
  74.       (not (null (environment-closure (lambda-environment fun)))))
  75.     (setf (entry-info-offset info) (gen-label))
  76.     (setf (entry-info-name info)
  77.       (let ((name (leaf-name internal-fun)))
  78.         (or name
  79.         (component-name (block-component (node-block bind))))))
  80.     (when (policy bind (>= debug 1))
  81.       (setf (entry-info-arguments info) (make-arg-names internal-fun))
  82.       (setf (entry-info-type info) (type-specifier (leaf-type internal-fun)))))
  83.   (undefined-value))
  84.  
  85.  
  86. ;;; REPLACE-TOP-LEVEL-XEPS  --  Interface
  87. ;;;
  88. ;;;    Replace all references to Component's non-closure XEPS that appear in
  89. ;;; top-level components, changing to :TOP-LEVEL-XEP functionals.  If the
  90. ;;; cross-component ref is not in a :TOP-LEVEL component, or is to a closure,
  91. ;;; then substitution is suppressed.
  92. ;;;
  93. ;;; When a cross-component ref is not substituted, we return T to indicate that
  94. ;;; early deletion of this component's IR1 should not be done.  We also return
  95. ;;; T if this component contains :TOP-LEVEL lambdas (though it is not a
  96. ;;; :TOP-LEVEL component.)
  97. ;;;
  98. ;;; We deliberately don't use the normal reference deletion, since we don't
  99. ;;; want to trigger deletion of the XEP (although it shouldn't hurt, since this
  100. ;;; is called after Component is compiled.)  Instead, we just clobber the
  101. ;;; REF-LEAF.
  102. ;;;
  103. (defun replace-top-level-xeps (component)
  104.   (let ((res nil))
  105.     (dolist (lambda (component-lambdas component))
  106.       (case (functional-kind lambda)
  107.     (:external
  108.      (let* ((ef (functional-entry-function lambda))
  109.         (new (make-functional :kind :top-level-xep
  110.                       :info (leaf-info lambda)
  111.                       :name (leaf-name ef)
  112.                       :lexenv (make-null-environment)))
  113.         (closure (environment-closure
  114.               (lambda-environment (main-entry ef)))))
  115.        (dolist (ref (leaf-refs lambda))
  116.          (let ((ref-component (block-component (node-block ref))))
  117.            (cond ((eq ref-component component))
  118.              ((or (not (eq (component-kind ref-component) :top-level))
  119.               closure)
  120.               (setq res t))
  121.              (t
  122.               (setf (ref-leaf ref) new)
  123.               (push ref (leaf-refs new))))))))
  124.     (:top-level
  125.      (setq res t))))
  126.     res))
  127.